home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / CRS / crs54.d81 / trans12c.lbr / TRANS-01.INC next >
Text File  |  2009-10-10  |  6KB  |  284 lines
  1.  
  2. (* module 01 *)
  3.  
  4. procedure Box(X1,Y1,X2,Y2: integer);
  5. var
  6.   I: integer;
  7. begin
  8. gotoxy(X1,Y1);
  9. for I:= X1 to X2 do write('*');
  10. for I:= Y1 to Y2 do
  11.   begin
  12.   gotoxy(X2,I);
  13.   write('*');
  14.   end;
  15. gotoxy(X1,Y2);
  16. for I:= X2 downto X1 do write('*');
  17. for I:= Y2 downto Y1 do
  18.   begin
  19.   gotoxy(X1,I);
  20.   write('*');
  21.   end;
  22. end;
  23.  
  24.  
  25.  
  26. function MainSelection: char;
  27. var
  28.   Ch: char;
  29. begin
  30. ClrScr;
  31. Box(13,5,60,23);
  32. writeln('* TRANSFER - vers ',Vers,' - Commodore 128/1571 ');
  33. gotoxy(MenuMargin,8);
  34. write('   CP/M= ',chr(CPM_Drive+ord('A')),':');
  35. write('             MS-DOS= ',chr(MS_DOS_Drive+ord('A')),':');
  36.  
  37. gotoxy(MenuMargin,10);
  38. write('1. Transfer File:  CP/M ==> MS-DOS');
  39.  
  40. gotoxy(MenuMargin,11);
  41. write('2. Transfer File:  CP/M <== MS-DOS');
  42.  
  43. gotoxy(MenuMargin,12);
  44. write('3. Directory of      MS-DOS Disk');
  45.  
  46. gotoxy(MenuMargin,13);
  47. write('4. Allocation Map    MS-DOS Disk');
  48.  
  49. gotoxy(MenuMargin,14);
  50. write('5. Directory of      CP/M Disk');
  51.  
  52. gotoxy(MenuMargin,15);
  53. write('6. Erase File        MS-DOS Disk');
  54.  
  55. gotoxy(MenuMargin,16);
  56. write('7. Restore FAT');
  57.  
  58. gotoxy(MenuMargin,17);
  59. write('8. Rename File       MS-DOS Disk');
  60.  
  61. gotoxy(MenuMargin,18);
  62. write('9. Format Disk       MS-DOS Disk');
  63.  
  64. gotoxy(MenuMargin,19);
  65. write('0. View Text File    MS-DOS Disk');
  66.  
  67. repeat
  68.   gotoxy(16,21);
  69.   write(' Enter Your Selection (<ESC> to Quit): ');
  70.   read(KBD,Ch);
  71.   until (Ch in [#27, '0'..'9']);
  72. MainSelection:= Ch;
  73. end;
  74.  
  75.  
  76.  
  77. procedure Continue;
  78. var
  79.   Ch: char;
  80. begin
  81. write('Press [Return] to Continue..');
  82. repeat
  83.   read(KBD,Ch);
  84.   if (Ch = #27) then Stop := true;
  85.   until (Ch = #$D);
  86. end;
  87.  
  88.  
  89.  
  90. procedure NextSector(var S: integer; var T: integer);
  91. begin
  92. S:= S + 1;
  93. if (S >= NSectors) then
  94.   begin
  95.   S:= MinSector;
  96.   T:= T + 1;
  97.   end;
  98. end;
  99.  
  100.  
  101.  
  102. procedure DiskError;
  103. begin
  104. writeln;
  105. write('Disk I/O Error, ');
  106. Continue;
  107. end;
  108.  
  109.  
  110.  
  111. procedure BiosSelect(DriveCode: integer; First: Boolean);
  112. begin
  113. if not ((Selection = '0') and (DriveCode = CPM_Drive)) then
  114.   begin
  115.   if (CPMversion >= $30) then
  116.     bdos(LOGDSK, DriveCode);                   {added for safety}
  117.   if First then
  118.     D := bios3(SELDSK,0,DriveCode,0,0)
  119.   else
  120.     D := bios3(SELDSK,0,DriveCode,1,0);
  121.   BiosError := (D = 0);
  122.   if DEBUG then
  123.     begin
  124.     writeln;
  125.     writeln('DriveCode=', DriveCode, '  DPH Address=', D);
  126.     end;
  127.   end;
  128. end;
  129.  
  130.  
  131.  
  132. procedure ReadSector(Sector,Track,Address: integer);
  133. var
  134.   Rec: integer;
  135.   RPS: integer;
  136.   I:   integer;
  137. begin
  138. {if SingleSided then Track:= Track * 2;}
  139. RPS:= SectorSize div 128;
  140. if (CPMversion >= $30) then RPS := 1;
  141. BiosError:= False;
  142. for I:= 0 to (RPS -1)do
  143.   begin
  144.   D := bios3(SETTRK,0,track,0,0);              (* select track     *)
  145.   if SecTrans then
  146.     Rec:= bios3(SECTRAN,0,Sector * RPS + I + SO,0,0)  (* translate sector *)
  147.   else
  148.     Rec:= (Sector * RPS + I + SO);
  149.   D := bios3(SETSEC,0,Rec,0,0);                (* select sector    *)
  150.   D := bios3(SETDMA,0,(I * 128) + Address,0,0);(* set dma addr     *)
  151.   BiosError:= (BiosError or (bios3(RDSEC,0,0,0,0)<>0)); (* read 128 bytes   *)
  152.   end;
  153. if BiosError then DiskError;
  154. end;
  155.  
  156.  
  157.  
  158. procedure WriteSector(Sector,Track,Address: integer);
  159. var
  160.   Rec: integer;
  161.   RPS: integer;
  162.   I:   integer;
  163. begin
  164. {if SingleSided then Track:= Track * 2;}
  165. RPS:= SectorSize div 128;
  166. if (CPMversion >= $30) then RPS := 1;
  167. BiosError:= False;
  168. for I:= 0 to (RPS -1)do
  169.   begin
  170.   D := bios3(SETTRK,0,track,0,0);              (* select track     *)
  171.   if SecTrans then
  172.     Rec:= bios3(SECTRAN,0,Sector * RPS + I + SO,0,0)  (* translate sector *)
  173.   else
  174.     Rec:= (Sector * RPS + I + SO);
  175.   D := bios3(SETSEC,0,Rec,0,0);                (* select sector    *)
  176.   D := bios3(SETDMA,0,(I * 128) + Address,0,0);(* set dma addr     *)
  177.   BiosError:= (BiosError or (bios3(WRSEC,0,0,0,0)<>0)); (* write 128 bytes *)
  178.   end;
  179. if BiosError then DiskError;
  180. end;
  181.  
  182.  
  183.  
  184. procedure GetFAT;
  185. begin
  186. ReadSector(FirstFATSector,0,addr(FAT));
  187. ReadSector(FirstFATSector + 1,0,addr(FAT)+SectorSize);
  188. end;
  189.  
  190.  
  191. procedure PutFAT;
  192. var
  193.   S,T,I: integer;
  194. begin
  195. S:= FirstFATSector;
  196. T:= 0;
  197. for I:= 0 to FATSize-1 do
  198.   begin
  199.   WriteSector(S,T,addr(FAT) + (SectorSize * I));
  200.   NextSector(S,T);
  201.   end;
  202. end;
  203.  
  204.  
  205. procedure ReadCluster(Cl, BufferIndex: integer);
  206. var
  207.   I:      integer;
  208.   Sector: integer;
  209.   Track:  integer;
  210. begin
  211. Cl:= Cl - 2;
  212. Track:= (Cl * SecsPerCluster) div NSectors;
  213. Sector:= (Cl * SecsPerCluster) mod NSectors;
  214. Sector:= Sector + FirstDataSector;
  215. Track:= Track + FirstDataTrack + (Sector div NSectors);
  216. Sector:= Sector mod NSectors;
  217. for I:= 0 to (SecsPerCluster -1) do
  218.   begin
  219.   ReadSector(Sector,Track,addr( DataBuffer[ I * SectorSize + BufferIndex] ));
  220.   NextSector(Sector,Track);
  221.   end;
  222. end;
  223.  
  224.  
  225.  
  226. procedure WriteCluster(Cl, BufferIndex: integer);
  227. var
  228.   I:      integer;
  229.   Sector: integer;
  230.   Track:  integer;
  231. begin
  232. Cl:= Cl - 2;
  233. Track:= (Cl * SecsPerCluster) div NSectors;
  234. Sector:= (Cl * SecsPerCluster) mod NSectors;
  235. Sector:= Sector + FirstDataSector;
  236. Track:= Track + FirstDataTrack + (Sector div NSectors);
  237. Sector:= Sector mod NSectors;
  238. for I:= 0 to (SecsPerCluster -1) do
  239.   begin
  240.   WriteSector(Sector,Track,addr( DataBuffer[ I * SectorSize + BufferIndex] ));
  241.   NextSector(Sector,Track);
  242.   end;
  243. end;
  244.  
  245.  
  246.  
  247. function FATPointer(Index: integer): Integer; (* 2..NClusters + 2 *)
  248. var
  249.   Result,I:    Integer;
  250.   OddNum:      Boolean;
  251. begin
  252. I:= ((Index * 3) div 2) +1;
  253. Result:= (FAT[I] + (256 * FAT[I + 1]));
  254. if odd(Index) then Result:= Result shr 4;
  255. FATPointer:= (Result and $FFF);
  256. end;
  257.  
  258.  
  259.  
  260. function Break: boolean;
  261. var
  262.   Ch: char;
  263. begin
  264. if KeyPressed then
  265.   begin
  266.   read(KBD,Ch);
  267.   if (Ch = ^S) then
  268.     begin
  269.     while not KeyPressed do;
  270.     read(KBD,Ch);
  271.     end;
  272.   if (Ch = #27) then
  273.     Break:= true
  274.   else
  275.     Break:= false;
  276.   end
  277. else
  278.   Break:= false;
  279. end;
  280.  
  281.  
  282.  
  283. (* end module 01 *)
  284.